home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / teglp.zip / SAMPROGS.ZIP / HTEST04.PAS < prev    next >
Pascal/Delphi Source File  |  1990-06-29  |  2KB  |  86 lines
  1.  
  2. USES
  3.     crt,
  4.     graph,
  5.     TEGLfont,
  6.     TEGLIcon,
  7.     TEGLIntr,
  8.     FastGrph;
  9.  
  10. const
  11.   TEGLBackPattern    : FillPatternType = ($AA,$55,$AA,$55,$AA,$55,$AA,$55);
  12.  
  13. var
  14.   ch : char;
  15.   i,sx,sy  : word;
  16.  
  17. procedure ClearTEGLScreen;
  18.    begin
  19.       setbkcolor(black);
  20.       SetFillPattern(TEGLBackPattern,1);
  21.       Bar(0,0,getmaxx,getmaxy);
  22.       SetColor(1);
  23.       Rectangle(0,0,getmaxx,getmaxy);
  24.    end;
  25.  
  26.  
  27. procedure waitforkey;
  28.    begin
  29.       while keypressed do ch:=readkey;
  30.       while not keypressed do;
  31.       while keypressed do ch:=readkey;
  32.    end;
  33.  
  34. procedure testgetbiti(x,y,x1,y1,wx,wy:word);
  35.    var    mysize : word;
  36.     buffer : pointer;
  37.    begin
  38.       mysize := bigimagesize(x,y,x1,y1);
  39.       getmem(buffer,mysize);
  40.       GetBitI(x,y,x1,y1,buffer);
  41.       putbiti(wx,wy,buffer,FGNORM);
  42.       putbiti(wx,wy+25,buffer,FGAND);
  43.       putbiti(wx,wy+50,buffer,FGOR);
  44.       putbiti(wx,wy+75,buffer,FGXOR);
  45.       putbiti(wx,wy+100,buffer,FGNOT);
  46.       freemem(buffer,mysize);
  47.    end;
  48.  
  49. begin
  50.    Herc720x348x2;
  51.    Init_TEGLIntr;
  52.    setmouseminmax(0,0,getmaxx,getmaxy);
  53.  
  54.    clearteglscreen;
  55.  
  56.    Putpict(5,5,@imageok,black);
  57.    Putpict(5,35,@imagecredits,black);
  58.  
  59.    pictsize(sx,sy,@imagecredits);
  60.  
  61.    setfillstyle(solidfill,white);
  62.    bar(155+1*(sx+50),1,155+2*(sx+50),getmaxy-1);
  63.    setfillstyle(solidfill,black);
  64.    bar(155+2*(sx+50),1,155+3*(sx+50),getmaxy-1);
  65.  
  66.    testgetbiti(5,35,5+sx-1,35+sy-1,155+0*(sx+50)+25,35);
  67.    testgetbiti(5,35,5+sx-1,35+sy-1,155+1*(sx+50)+25,35);
  68.    testgetbiti(5,35,5+sx-1,35+sy-1,155+2*(sx+50)+25,35);
  69.  
  70.    setcolor(white);
  71.    fonttable := @font14;
  72.    bar(155+3*(sx+50)+10,35,155+3*(sx+50)+80,35+teglcharheight+2);
  73.    outtegltextxy(155+3*(sx+50)+12,37,'FGNORM');
  74.    bar(155+3*(sx+50)+10,35+25,155+3*(sx+50)+80,35+teglcharheight+2+25);
  75.    outtegltextxy(155+3*(sx+50)+12,37+25,'FGAND');
  76.    bar(155+3*(sx+50)+10,35+50,155+3*(sx+50)+80,35+teglcharheight+2+50);
  77.    outtegltextxy(155+3*(sx+50)+12,37+50,'FGOR');
  78.    bar(155+3*(sx+50)+10,35+75,155+3*(sx+50)+80,35+teglcharheight+2+75);
  79.    outtegltextxy(155+3*(sx+50)+12,37+75,'FGXOR');
  80.    bar(155+3*(sx+50)+10,35+100,155+3*(sx+50)+80,35+teglcharheight+2+100);
  81.    outtegltextxy(155+3*(sx+50)+12,37+100,'FGNOT');
  82.  
  83.    showmouse;
  84.    waitforkey;
  85. end.
  86.